Análisis Demográfico 1

Análisis Demográfico 1

Dr. Víctor Manuel García Guerrero

vmgarcia@colmex.mx

Limpieza de la base de datos Data

Cargamos la base de datos Data es su forma “cruda”

Code
library(DT)
load("R/data.RData")
datatable(data, options = list(scrollX = TRUE, scrollY = "500px"))

Nota

Sientase libre de jugar con la tabla de valores. Note que hay renglones y casillas en blanco que corresponden a valores no especificados, NA. Note también que hay casillas del tipo De 5 a 9 años. Nuestra labor será limpiar o eliminar estos renglones y casillas.

Limpieza de la base de datos Data

Ahora, asignemos nombres a las columnas de nuestra tabla de datos.

Code
library(DT)
load("R/data.RData")
names(data)<-
  c("id","edo","age","both","males","females")
datatable(data, options = list(scrollX = TRUE, scrollY = "500px"))

Limpieza de la base de datos Data

Filtremos los renglones de la tabla de datos Data, manteniendo solo aquellos de la columna edo que no tienen valores NA y asignemos esta tabla filtrada a una nueva tabla de datos base_mx

Code
library(DT)
library(tidyverse)
load("R/data.RData")
names(data)<-
  c("id","edo","age","both","males","females")
base_mx <- data %>% 
  filter(is.na(edo) == FALSE)
datatable(base_mx, options = list(scrollX = TRUE, scrollY = "500px"))

Limpieza de la base de datos Data

Seleccionemos todas las columnas, excepto id y both

Code
library(DT)
library(tidyverse)
load("R/data.RData")
names(data)<-
  c("id","edo","age","both","males","females")
base_mx <- data %>% 
  filter(is.na(edo) == FALSE) %>% 
  select(-c("id", "both"))
datatable(base_mx, options = list(scrollX = TRUE, scrollY = "500px"))

Limpieza de la base de datos Data

Despues de aplicar na.omit() a base_mx, solo nos quedaremos con los renglones donde no hay valores NA.

Code
library(DT)
library(tidyverse)
load("R/data.RData")
names(data)<-
  c("id","edo","age","both","males","females")
base_mx <- data %>% 
  filter(is.na(edo) == FALSE) %>% 
  select(-c("id", "both")) %>%
  na.omit() 
datatable(base_mx, options = list(scrollX = TRUE, scrollY = "500px"))

Nota

En la tabla, busque valores donde la variable age tome el valor “Total”

Limpieza de la base de datos Data

En este segundo filter() estamos eliminando los renglones donde:

  • el valor age es Total

  • la columna age contiene la palabra De

  • la columna age contiene la palabra 85 años

Code
library(tidyverse)
library(stringr)
library(DT)
load("R/data.RData")
names(data)<-
  c("id","edo","age","both","males","females")
base_mx <- data %>% 
  filter(is.na(edo) == FALSE) %>% 
  select(-c("id", "both")) %>%
  na.omit() %>%
  filter(
    age != "Total",
    !grepl("De", age),
    !grepl("85 años", age)
  )
datatable(base_mx, options = list(scrollX = TRUE, scrollY = "500px"))

Limpieza de la base de datos Data

La función mutate es usada para modificar una columna existente o agregar una nueva. En nuestro caso, modificaremos nuestra columna age para extraer el valor numérico de todos los renglones.

Code
library(tidyverse)
library(stringr)
library(DT)
load("R/data.RData")
names(data)<-
  c("id","edo","age","both","males","females")
base_mx <- data %>% 
  filter(is.na(edo) == FALSE) %>% 
  select(-c("id", "both")) %>%
  na.omit() %>%
  filter(
    age != "Total",
    !grepl("De", age),
    !grepl("85 años", age)
  ) %>%
  mutate(age = str_extract(age,"\\d+"))
datatable(base_mx, options = list(scrollX = TRUE, scrollY = "500px"))

Limpieza de la base de datos Data

La función gather()nos ayudará a transformar las columnas male y female en filas, creando nuevas columnas sex y pob. Por otro lado type_convert()se utiliza para convertir automáticamente las columnas de un data frame a los tipos de datos más apropiados según su contenido. En nuestro caso, la variable age pasará de string a numeric

Code
library(tidyverse)
library(stringr)
library(DT)
load("R/data.RData")
names(data)<-
  c("id","edo","age","both","males","females")
base_mx <- data %>% 
  filter(is.na(edo) == FALSE) %>% 
  select(-c("id", "both")) %>%
  na.omit() %>%
  filter(
    age != "Total",
    !grepl("De", age),
    !grepl("85 años", age)
  ) %>%
  mutate(age = str_extract(age,"\\d+")) %>%
  gather(key = sex, value = pob, -age, -edo) %>% 
  type_convert()
datatable(base_mx, options = list(scrollX = TRUE, scrollY = "500px"))

Limpieza de la base de datos Data

Usaremos la función mutate() para crear una nueva columan pop2. Si sex toma el valor de female entonces pop2 tomará el valor de pop; en otro caso, pop2 tomará el valor de -pop Finalmente guardaremos nuestra nueva tabla de datos base_mx en nuestra carpeta output

Code
library(tidyverse)
library(stringr)
library(DT)
load("R/data.RData")
names(data)<-
  c("id","edo","age","both","males","females")
base_mx <- data %>% 
  filter(is.na(edo) == FALSE) %>% 
  select(-c("id", "both")) %>%
  na.omit() %>%
  filter(
    age != "Total",
    !grepl("De", age),
    !grepl("85 años", age)
  ) %>%
  mutate(age = str_extract(age,"\\d+")) %>%
  gather(key = sex, value = pob, -age, -edo) %>% 
  type_convert() %>% 
  mutate(pob2 = ifelse(sex == "females", pob, -pob))
save(base_mx, file = "input/base_mx.RData")
datatable(base_mx, options = list(scrollX = TRUE, scrollY = "500px"))

Pirámide de población con la tabla de datos Base_mx

Para la gráfica de la piramide de población, tomaremos en cuenta la población total. Para esta labor, recordemos que deberemos omitir los valores NA.

Code
library(tidyverse)
library(DT)
base_mx <- base_mx %>%
  filter(edo == "Total", is.na(age) == FALSE)
datatable(base_mx, options = list(scrollX = TRUE, scrollY = "500px"))

Pirámide de población con la tabla de datos Base_mx

Code
library(tidyverse)
base_mx %>%
  filter(edo == "Total", is.na(age) == FALSE) %>%
  ggplot() +
  geom_bar(aes(x = age, y = pob2/1000000, fill = age),
           stat = "identity",
           show.legend = F)

Pirámide de población con la tabla de datos Base_mx

Code
library(tidyverse)
base_mx %>%
  filter(edo == "Total", is.na(age) == FALSE) %>%
  ggplot() +
  geom_bar(aes(x = age, y = pob2/1000000, fill = age),
           stat = "identity",
           show.legend = F) +
  coord_flip() +
    geom_hline(yintercept = 0)

Pirámide de población con la tabla de datos Base_mx

Code
library(tidyverse)
base_mx %>%
  filter(edo == "Total", is.na(age) == FALSE) %>%
  ggplot() +
  geom_bar(aes(x = age, y = pob2/1000000, fill = age),
           stat = "identity",
           show.legend = F) +
  coord_flip() +
  geom_hline(yintercept = 0) +
  scale_y_continuous(
    limits = c(-1.25, 1.25),
    breaks = seq(-1.25, 1.25, 0.25),
    labels = as.character(
      c(seq(1.25, 0, -0.25),seq(0.25, 1.25, 0.25)
      ))
  )

Pirámide de población con la tabla de datos Base_mx

Code
library(tidyverse)
base_mx %>%
  filter(edo == "Total", is.na(age) == FALSE) %>%
  ggplot() +
  geom_bar(aes(x = age, y = pob2/1000000, fill = age),
           stat = "identity",
           show.legend = F) +
  coord_flip() +
  geom_hline(yintercept = 0) +
  scale_y_continuous(
    limits = c(-1.25, 1.25),
    breaks = seq(-1.25, 1.25, 0.25),
    labels = as.character(
      c(seq(1.25, 0, -0.25),seq(0.25, 1.25, 0.25)
      ))
  )+
  scale_x_continuous(
    limits = c(-1, 101), breaks = seq(0, 100, 5),
    labels = seq(0, 100, 5)
  )

Pirámide de población con la tabla de datos Base_mx

Code
library(tidyverse)
base_mx %>%
  filter(edo == "Total", is.na(age) == FALSE) %>%
  ggplot() +
  geom_bar(aes(x = age, y = pob2/1000000, fill = age),
           stat = "identity",
           show.legend = F) +
  coord_flip() +
  geom_hline(yintercept = 0) +
  scale_y_continuous(
    limits = c(-1.25, 1.25),
    breaks = seq(-1.25, 1.25, 0.25),
    labels = as.character(
      c(seq(1.25, 0, -0.25),seq(0.25, 1.25, 0.25)
      ))
  )+
  scale_x_continuous(
    limits = c(-1, 101), breaks = seq(0, 100, 5),
    labels = seq(0, 100, 5)
  )+
  annotate(
    geom = "text", x = 95, y = -1, label = "Hombres",
    color = "black", size = 3
  ) +
  annotate(
    geom = "text", x = 95, y = 1, label = "Mujeres",
    color = "black", size = 3
  )

Pirámide de población con la tabla de datos Base_mx

Code
library(tidyverse)

base_mx %>%
  filter(edo == "Total", is.na(age) == FALSE) %>%
  ggplot() +
  geom_bar(aes(x = age, y = pob2/1000000, fill = age),
           stat = "identity",
           show.legend = F) +
  coord_flip() +
  geom_hline(yintercept = 0) +
  scale_y_continuous(
    limits = c(-1.25, 1.25),
    breaks = seq(-1.25, 1.25, 0.25),
    labels = as.character(
      c(seq(1.25, 0, -0.25),
        seq(0.25, 1.25, 0.25)
      ))
  ) +
  scale_x_continuous(
    limits = c(-1, 101), breaks = seq(0, 100, 5),
    labels = seq(0, 100, 5)
  )+
  annotate(
    geom = "text", x = 95, y = -1, label = "Hombres",
    color = "black", size = 3
  ) +
  annotate(
    geom = "text", x = 95, y = 1, label = "Mujeres",
    color = "black", size = 3
  ) +
  theme_light()

Pirámide de población con la tabla de datos Base_mx

Code
library(tidyverse)

base_mx %>%
  filter(edo == "Total", is.na(age) == FALSE) %>%
  ggplot() +
  geom_bar(aes(x = age, y = pob2/1000000, fill = age),
           stat = "identity",
           show.legend = F) +
  coord_flip() +
  geom_hline(yintercept = 0) +
  scale_y_continuous(
    limits = c(-1.25, 1.25),
    breaks = seq(-1.25, 1.25, 0.25),
    labels = as.character(
      c(seq(1.25, 0, -0.25),
        seq(0.25, 1.25, 0.25)
      ))
  ) +
  scale_x_continuous(
    limits = c(-1, 101), breaks = seq(0, 100, 5),
    labels = seq(0, 100, 5)
  )+
  annotate(
    geom = "text", x = 95, y = -1, label = "Hombres",
    color = "black", size = 3
  ) +
  annotate(
    geom = "text", x = 95, y = 1, label = "Mujeres",
    color = "black", size = 3
  ) +
  theme_light() +
  scale_fill_viridis_c(option = "A", guide = guide_colorbar())+
  labs(y = "Población (millones)", x = "Edad", fill = "Edad")

Ejercicio de práctica 1

Escoja algún estado de la tabla de datos base_mx y determine su pirámide de población.

Ejercicio de práctica 2

Calcule la proporción de gente no especificada de población total para ambos sexos, hombres y mujeres.

  • Para esto, use un left_join para unir dos tablas.

    • La tabla izquierda deberá contar con la población total pob para ambos sexos.

    • La tabla derecha deberá contar con la población total no especificada pob_na para ambos sexos.

  • Calcule la proporción rat de la poblacion total no especificada en porcentaje.

Code
library(tidyverse)
library(DT)
load("input/base_mx.RData")
base_mx <- left_join(
  base_mx %>% 
    filter(edo == "Total", is.na(age) == F) %>% 
    group_by(sex) %>% 
    summarise(pob = sum(pob), .groups = "drop"),
  base_mx %>% 
    filter(edo== "Total", is.na(age) == T) %>% 
    select(sex, pob_na = pob),
  by = "sex") %>% 
  mutate(rat = 100 * pob_na / pob)
datatable(base_mx, options = list(scrollX = TRUE, scrollY = "500px"))

Prorateo de la tabla de datos base_mx

Tabla izquierda

Code
library(tidyverse)
library(DT)
load("input/base_mx.RData")
tabla_izq <- base_mx %>% 
    filter(edo == "Total")
datatable(tabla_izq, options = list(scrollX = TRUE, scrollY = "500px"))

Prorateo de la tabla de datos base_mx

Code
library(tidyverse)
library(DT)
tabla_izq <-  base_mx %>% 
    filter(edo == "Total") %>% 
    group_by(sex) %>% 
    mutate(prop = pob / sum(pob))
datatable(tabla_izq, options = list(scrollX = TRUE, scrollY = "500px"))

Prorateo de la tabla de datos base_mx

Code
library(tidyverse)
library(DT)
tabla_izq <-   base_mx %>% 
    filter(edo == "Total") %>% 
    group_by(sex) %>% 
    mutate(prop = pob / sum(pob)) %>% 
    filter(is.na(age) == F) 
datatable(tabla_izq, options = list(scrollX = TRUE, scrollY = "500px"))

Prorateo de la tabla de datos base_mx

Code
library(tidyverse)
library(DT)
tabla_izq <-   base_mx %>% 
    filter(edo == "Total") %>% 
    group_by(sex) %>% 
    mutate(prop = pob / sum(pob)) %>% 
    filter(is.na(age) == F) %>%
    ungroup()
datatable(tabla_izq, options = list(scrollX = TRUE, scrollY = "500px"))

Prorateo de la tabla de datos base_mx

Tabla derecha

Code
library(tidyverse)
library(DT)
tabla_izq <-   base_mx %>% 
    filter(edo == "Total") %>% 
    group_by(sex) %>% 
    mutate(prop = pob / sum(pob)) %>% 
    filter(is.na(age) == F) %>%
    ungroup()
tabla_der <- base_mx %>% 
    filter(edo == "Total", is.na(age) == T)
datatable(tabla_der, options = list(scrollX = TRUE, scrollY = "500px"))

Prorateo de la tabla de datos base_mx

Code
library(tidyverse)
library(DT)
tabla_izq <-   base_mx %>% 
    filter(edo == "Total") %>% 
    group_by(sex) %>% 
    mutate(prop = pob / sum(pob)) %>% 
    filter(is.na(age) == F) %>%
    ungroup()
tabla_der <- base_mx %>% 
    filter(edo == "Total", is.na(age) == T) %>% 
    select(sex, pob_na = pob)
datatable(tabla_der, options = list(scrollX = TRUE, scrollY = "500px"))

Prorateo de la tabla de datos base_mx

Tabla de datos prorateada base_mx_pror

Code
library(tidyverse)
library(DT)
tabla_izq <-   base_mx %>% 
    filter(edo == "Total") %>% 
    group_by(sex) %>% 
    mutate(prop = pob / sum(pob)) %>% 
    filter(is.na(age) == F) %>%
    ungroup()
tabla_der <- base_mx %>% 
    filter(edo == "Total", is.na(age) == T) %>% 
    select(sex, pob_na = pob)
base_mx_pror <-  left_join(tabla_izq,tabla_der,by = "sex")
datatable(base_mx_pror, options = list(scrollX = TRUE, scrollY = "500px"))

Prorateo de la tabla de datos base_mx

Recordemos la formula para la población final, \(N^*_x\), para la variable pop_fin.

Code
library(tidyverse)
library(DT)
tabla_izq <-   base_mx %>% 
    filter(edo == "Total") %>% 
    group_by(sex) %>% 
    mutate(prop = pob / sum(pob)) %>% 
    filter(is.na(age) == F) %>%
    ungroup()
tabla_der <- base_mx %>% 
    filter(edo == "Total", is.na(age) == T) %>% 
    select(sex, pob_na = pob)
base_mx_pror <-  left_join(tabla_izq,tabla_der,by = "sex")
base_mx_pror <-  base_mx_pror %>% 
                    mutate(pob_fin = pob + pob_na * prop)
datatable(base_mx_pror, options = list(scrollX = TRUE, scrollY = "500px"))

\(N^*_x = N_x + N_{ne} \frac{N_x}{\sum_{x=0}^w N_x}\)

Prorateo de la tabla de datos base_mx

Resultado final para la tabla de datos base_mx_pror

Code
library(tidyverse)
library(DT)
tabla_izq <-   base_mx %>% 
    filter(edo == "Total") %>% 
    group_by(sex) %>% 
    mutate(prop = pob / sum(pob)) %>% 
    filter(is.na(age) == F) %>%
    ungroup()
tabla_der <- base_mx %>% 
    filter(edo == "Total", is.na(age) == T) %>% 
    select(sex, pob_na = pob)
base_mx_pror <-  left_join(tabla_izq,tabla_der,by = "sex")
base_mx_pror <-  base_mx_pror %>% 
                    mutate(pob_fin = pob + pob_na * prop) %>% 
                    select(age, sex, pob = pob_fin)
datatable(base_mx_pror, options = list(scrollX = TRUE, scrollY = "500px"))

Indice